home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / H406.ZIP / TOTSRC11.ZIP / TOTFAST.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-04  |  59KB  |  2,185 lines
  1. {               Copyright 1991 TechnoJock Software, Inc.               }
  2. {                          All Rights Reserved                         }
  3. {                         Restricted by License                        }
  4.  
  5. {                             Build # 1.10                             }
  6.  
  7. Unit totFAST;
  8. {$I TOTFLAGS.INC}
  9.  
  10. {
  11.  Development History:
  12.              Mar 15 91  1.00a   Changed DesqView checks
  13.              May  3 91  1.00b   Read Char checks
  14.              May  3 91  1.00c   Changed virtual write and writeln
  15.              Jun  2 91  1.00d   Corrected WriteOBJ CRT calls
  16.              Jul 10 91  1.00e   Corrected WriteCenter method, and CursOff
  17.              Nov 06 91  1.00f   Real correction of WriteCenter
  18.              Feb 05 92  1.00g   Corrected cursor restores after saves
  19. }
  20.  
  21. INTERFACE
  22.  
  23. uses DOS, CRT, totSYS, totLOOK, totINPUT;
  24.  
  25. TYPE
  26.  
  27. StrScreen = string[255];   {alter as necessary}
  28. StrVisible = string[80];   {alter as necessary}
  29. tDirection = (Up, Down, Left, Right, Vert, Horiz);
  30. tCoords = record
  31.    X1,Y1,X2,Y2:shortint;
  32. end;
  33. tByteCoords = record
  34.    X1,Y1,X2,Y2:byte;
  35. end;
  36. ShadowPosition = (UpLeft,UpRight,DownLeft,DownRight);
  37.  
  38. WritePtr = ^WriteOBJ;
  39. pWriteOBJ = ^WriteOBJ;
  40. WriteOBJ = object
  41.    vWidth: byte;           {how wide is screen}
  42.    vScreenPtr: pointer;    {memory location of screen data}
  43.    vWindow: tByteCoords;   {active screen area}
  44.    vWindowOn: boolean;     {is window area active}
  45.    vWindowIgnore: boolean; {ignore window settings}
  46.    vTempX: byte;
  47.    vTempY: byte;
  48.    {methods...}
  49.    constructor Init;
  50.    procedure   SetScreen(var P:Pointer; W:byte);
  51.    function    WindowOff: boolean;
  52.    procedure   SetWinIgnore(On:Boolean);
  53.    procedure   WindowOn;
  54.    procedure   WindowCoords(var Coords: tByteCoords);
  55.    function    WindowActive: boolean;
  56.    function    WindowInEffect: boolean;
  57.    function    WinX: byte;
  58.    function    WinY: byte;
  59.    procedure   GetWinCoords(var X1,Y1,X2,Y2:byte);
  60.    procedure   GetCursorPos;
  61.    procedure   SetCursorPos;
  62.    procedure   WriteAT(X,Y,attr:byte;Str:string);                     VIRTUAL;
  63.    procedure   WritePlain(X,Y:byte;Str:string);                       VIRTUAL;
  64.    procedure   Write(Str:string);                                     VIRTUAL;
  65.    procedure   WriteLn(Str:string);                                   VIRTUAL;
  66.    procedure   GotoXY(X,Y: word);                                     VIRTUAL;
  67.    function    WhereX: word;                                          VIRTUAL;
  68.    function    WhereY: word;                                          VIRTUAL;
  69.    procedure   SetWindow(X1,Y1,X2,Y2: byte);                          VIRTUAL;
  70.    procedure   ResetWindow;                                           VIRTUAL;
  71.    procedure   ChangeAttr(X,Y,Att:byte;Len:word);                     VIRTUAL;
  72.    procedure   MoveFromScreen(var Source,Dest;Len:Word);              VIRTUAL;
  73.    procedure   MoveToScreen(var Source,Dest; Len:Word);               VIRTUAL;
  74.    procedure   Clear(Att:byte;Ch:char);                               VIRTUAL;
  75.    destructor  Done;                                                  VIRTUAL;
  76. end; {WriteOBJ}
  77.  
  78. ScreenPtr = ^ScreenOBJ;
  79. pScreenOBJ = ^ScreenOBJ;
  80. ScreenOBJ = object
  81.    vWidth: byte;           {how wide is screen}
  82.    vDepth: byte;           {how many lines}
  83.    vScreenPtr: pointer;    {memory location of screen data}
  84.    vCursX: byte;           {cursor location}
  85.    vCursY: byte;           {      -"-      }
  86.    vCursTop: byte;         {cursor size}
  87.    vCursBot: byte;         {    -"-    }
  88.    oWritePtr: WritePtr;    {screen writing and moving object}
  89.    vHiMarker: char;        {character to indicate attribute change}
  90.    vVisible: boolean;      {is the screen mapped to visible display}
  91.    vOnScreen:boolean;
  92.    {methods...}
  93.    constructor Init;
  94.    procedure   SetHiMarker(M:char);
  95.    function    HiMarker:char;
  96.    procedure   AssignWriteOBJ(var Wri: WriteOBJ);
  97.    procedure   SetWindow(X1,Y1,X2,Y2: byte);
  98.    procedure   SetWinIgnore(On:Boolean);
  99.    procedure   ResetWindow;
  100.    function    WindowOff:boolean;
  101.    procedure   WindowOn;
  102.    procedure   WindowCoords(var Coords: tByteCoords);
  103.    function    WindowActive: boolean;
  104.    function    OnScreen:boolean;
  105.    function    CharHeight: integer;
  106.    procedure   CursReset;
  107.    procedure   CursSave; 
  108.    procedure   GotoXY(X,Y: word); 
  109.    procedure   CursSize(T,B: byte);
  110.    function    WhereX: word; 
  111.    function    WhereY: word;
  112.    function    CursTop: byte; 
  113.    function    CursBot: byte; 
  114.    procedure   CursHalf;
  115.    procedure   CursFull;
  116.    procedure   CursOn;
  117.    procedure   CursOff;
  118.    procedure   Exists; 
  119.    procedure   MoveToScreen(var Source, Dest; Length:word); 
  120.    procedure   MoveFromScreen(var Source, Dest; Length:word);
  121.    procedure   Save;
  122.    procedure   Create(X,Y,Attr:byte);
  123.    function    Width: byte; 
  124.    function    Depth: byte;
  125.    function    ScreenPtr: pointer; 
  126.    procedure   Display;
  127.    procedure   PartDisplay(X1,Y1,X2,Y2,X,Y:byte);
  128.    procedure   PartSlideDisplay(X1,Y1,X2,Y2:byte;Way:tDirection);
  129.    procedure   SlideDisplay(Way: tDirection);
  130.    procedure   PartSave (X1,Y1,X2,Y2:byte; VAR Dest);
  131.    procedure   PartRestore (X1,Y1,X2,Y2:byte; VAR Source);
  132.    procedure   CopyScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  133.    procedure   MoveScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  134.    procedure   Scroll(Way:tDirection;X1,Y1,X2,Y2:byte);
  135.    procedure   Write(Str:string);
  136.    procedure   WriteLn(Str:string);
  137.    procedure   WriteAT(X,Y,attr:byte;Str:string); 
  138.    procedure   WriteHi(X,Y,AttrHi,Attr:byte;Str:string);
  139.    procedure   WritePlain(X,Y:byte;Str:string); 
  140.    procedure   WriteCap(X,Y,AttrCap,Attr:byte;Str:string);
  141.    procedure   WriteClick(X,Y,attr:byte;Str:string);
  142.    procedure   WriteCenter(Y,Attr:byte;Str:string);
  143.    procedure   WriteBetween(X1,X2,Y,Attr:byte;Str:string);
  144.    procedure   WriteRight(X,Y,Attr:byte;Str:string);
  145.    procedure   WriteVert(X,Y,Attr:byte;Str:string);
  146.    procedure   Attrib(X1,Y1,X2,Y2,Attr:byte); 
  147.    procedure   Clear(Att:byte;Ch:char);
  148.    procedure   PartClear(X1,Y1,X2,Y2,Att:byte;Ch:char);
  149.    procedure   ClearText(X1,Y1,X2,Y2:byte);
  150.    procedure   ReadWord(X,Y:byte;var Attr:byte; var Ch : char); 
  151.    function    ReadChar(X,Y:byte):char;
  152.    function    ReadAttr(X,Y:byte):byte;
  153.    function    ReadStr(X1,X2,Y:byte):string;
  154.    procedure   BoxEngine(X1,Y1,X2,Y2,LeftPad,RightPad,Battr,Tattr,Mattr,style:byte;
  155.                          Filled:boolean;
  156.                          Title:string); 
  157.    procedure   TitleEngine(X1,Y1,X2,Y2,LeftPad,RightPad,Battr,Tattr:byte;Str,Title:string);
  158.    procedure   Box(X1,Y1,X2,Y2,attr,style:byte);
  159.    procedure   FillBox(X1,Y1,X2,Y2,attr,style:byte);
  160.    procedure   ShadFillBox(X1,Y1,X2,Y2,attr,style:byte);
  161.    procedure   TitledBox(X1,Y1,X2,Y2,Battr,Tattr,Mattr,style:byte;Title:string);
  162.    procedure   HorizLine(X1,X2,Y,Attr,Style : byte);
  163.    procedure   VertLine(X,Y1,Y2,Attr,Style:byte);
  164.    procedure   SmartVertLine(X,Y1,Y2,Attr,Style:byte);
  165.    procedure   SmartHorizLine(X1,X2,Y,Attr,Style:byte);
  166.    procedure   WriteHScrollBar(X1,X2,Y,Attr: byte; Current,Max: longint);
  167.    procedure   WriteVScrollBar(X,Y1,Y2,Attr: byte; Current,Max: longint);
  168.    destructor  Done;
  169. end; {ScreenOBJ}
  170.  
  171. pScrollOBJ = ^ScrollOBJ;
  172. ScrollOBJ = object
  173.    vUpArrowChar: char;
  174.    vDownArrowChar: char;
  175.    vLeftArrowChar: char;
  176.    vRightArrowChar: char;
  177.    vElevatorChar: char;
  178.    vBackgroundChar: char;
  179.    {methods...}
  180.    constructor Init;
  181.    procedure   SetDefaults;
  182.    procedure   SetScrollChars(U,D,L,R,E,B:char);
  183.    function    UpChar: char;
  184.    function    DownChar: char;
  185.    function    LeftChar: char;
  186.    function    RightChar: char;
  187.    function    ElevatorChar: char;
  188.    function    BackgroundChar: char;
  189.    destructor  Done;
  190. end; {ScrollOBJ}
  191.  
  192. pShadowOBJ = ^ShadowOBJ;
  193. ShadowOBJ = object
  194.    vShadPos: ShadowPosition;   {where is shadow}
  195.    vShadAttr: byte;            {shadow attribute}
  196.    vShadChar: char;            {shadow character - ' ' is see-through}
  197.    vShadWidth: byte;           {shadow width in characters}
  198.    vShadDepth: byte;           {shadow depth in characters}
  199.    {methods...}
  200.    constructor Init;
  201.    procedure   SetDefaults;
  202.    procedure   SetShadowStyle(ShadP:ShadowPosition; ShadA:byte; ShadC: char);
  203.    procedure   SetShadowSize(ShadW,ShadD:byte);
  204.    function    ShadWidth: byte;
  205.    function    ShadDepth: byte;
  206.    function    ShadAttr: byte;
  207.    function    ShadChar: char;
  208.    function    ShadPos: ShadowPosition;
  209.    procedure   DrawShadow(Border:tCoords);
  210.    procedure   DrawShadowXY(X1,Y1,X2,Y2:integer);
  211.    procedure   OuterCoords(Border:tCoords;var Outer:tCoords);
  212.    procedure   OuterXY(var X1,Y1,X2,Y2: integer);
  213.    destructor  Done;
  214. end; {ShadowOBJ}
  215.  
  216. VAR
  217.   Screen: ScreenOBJ;
  218.   ScrollTOT: ^ScrollOBJ;
  219.   ShadowTOT: ^ShadowOBJ;
  220.   SnowProne : byte;
  221.  
  222. function  CAttr(F,B:byte):byte;
  223. function  FAttr(A:byte): byte;
  224. function  BAttr(A:byte): byte;
  225. function  Replicate(N : byte; Character:char): string;
  226. procedure fastINIT;
  227.  
  228. IMPLEMENTATION
  229. Const
  230.     TitPos:string[6] = '<+>^|_';  {characters signifying box title position}
  231.     WinCursX: byte = 1;
  232.     WinCursY: byte = 1;
  233. {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  234. {                                                               }
  235. {     U N I T   P R O C E D U R E S   &   F U N C T I O N S     }
  236. {                                                               }
  237. {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  238.  
  239. procedure Error(Err:byte);
  240. {temp routine to display error - replace with object}
  241. const
  242.    Header = 'totFAST error: ';
  243. var
  244.    Msg : string;
  245. begin
  246.    Case Err of
  247.    1: Msg := 'Not enough memory to initialize screen';
  248.    2: Msg := 'Cannot write to inactive screen';
  249.    3: Msg := 'Not enough memory for screen move/copy';
  250.    else  Msg := 'Unknown Error';
  251.    end; {case}
  252.    Writeln(Header,Msg);
  253.    halt;
  254. end; {Error}
  255.  
  256. function CAttr(F,B:byte):byte;
  257. {converts foreground(F) and background(B) colors to combined Attribute byte}
  258. begin
  259.    CAttr := (B Shl 4) or F;
  260. end;  {CAttr}
  261.  
  262. function FAttr(A:byte): byte;
  263. {returns the foreground color from an attribute Byte}
  264. begin
  265.    FAttr := A and 15;
  266. end; {FAttr}
  267.  
  268. function BAttr(A:byte): byte;
  269. {returns the background color from an attribute Byte}
  270. begin
  271.    BAttr := (A and 112) shr 4;
  272. end; {FAttr}
  273.  
  274. function Replicate(N : byte; Character:char): string;
  275. {returns a string with Character repeated N times}
  276. var tempstr: string;
  277. begin
  278.     If N = 0 then
  279.        TempStr := ''
  280.     else
  281.     begin
  282.        Fillchar(tempstr,N+1,Character);
  283.        Tempstr[0] := chr(N);
  284.     end;
  285.     Replicate := Tempstr;
  286. end; {replicate}
  287.  
  288. {$L totFAST}
  289. {$F+}
  290.   procedure AsmWrite(var scrptr; Wid,Col,Row,Attr:byte; St:String); external;
  291.   procedure AsmPWrite(var scrptr; Wid,Col,Row:byte; St:String); external;
  292.   procedure AsmAttr(var scrptr; Wid,Col,Row,Attr,Len:byte); external;
  293.   Procedure AsmMoveFromScreen(var Source,Dest;Length:Word); external;
  294.   Procedure AsmMoveToScreen(var Source,Dest; Length:Word); external;
  295. {$IFNDEF OVERLAY}
  296.    {$F-}
  297. {$ENDIF}
  298.  
  299. {|||||||||||||||||||||||||||||||||||||||||}
  300. {                                         }
  301. {     W r i t e O B J   M E T H O D S     }
  302. {                                         }
  303. {|||||||||||||||||||||||||||||||||||||||||}
  304. constructor WriteOBJ.Init;
  305. {}
  306. begin
  307.    vWindowOn := false;
  308.    vWindowIgnore := false;
  309. end; {WriteOBJ.Init}
  310.  
  311. procedure WriteOBJ.SetScreen(var P:Pointer; W:byte);
  312. {}
  313. begin
  314.    vScreenPtr := P;
  315.    vWidth := W;
  316. end; {WriteOBJ.SetScreen}
  317.  
  318. procedure WriteOBJ.SetWindow(X1,Y1,X2,Y2: byte);
  319. {}
  320. begin
  321.    if Monitor^.BaseofScreen = vScreenPtr then  {1.00d}
  322.    begin
  323.       GetCursorPos;   {1.00g}
  324.       CRT.Window(X1,Y1,X2,Y2);
  325.       SetCursorPos;
  326.    end;
  327.    vWindow.X1 :=  X1;
  328.    vWindow.Y1 :=  Y1;
  329.    vWindow.X2 :=  X2;
  330.    vWindow.Y2 :=  Y2;
  331.    vWindowOn := true;
  332. end; {WriteOBJ.SetWindow}
  333.  
  334. procedure WriteOBJ.GetWinCoords(var X1,Y1,X2,Y2:byte);
  335. {}
  336. begin
  337.    X1 :=  vWindow.X1;
  338.    Y1 :=  vWindow.Y1;
  339.    X2 :=  vWindow.X2;
  340.    Y2 :=  vWindow.Y2;
  341. end; {WriteOBJ.GetWinCoords}
  342.  
  343. procedure WriteOBJ.ResetWindow;
  344. {}
  345. var H,W: byte;
  346. begin
  347.    W := Monitor^.Width;
  348.    H := Monitor^.Depth;
  349.    if Monitor^.BaseofScreen = vScreenPtr then  {1.00d}
  350.       CRT.Window(1,1,W,H);
  351.    vWindow.X1 := 1;
  352.    vWindow.Y1 := 1;
  353.    vWindow.X2 := W;
  354.    vWindow.Y2 := H;
  355.    vWindowOn := false;
  356. end; {WriteOBJ.ResetWindow}
  357.  
  358. function WriteOBJ.WindowOff:boolean;
  359. {}
  360. begin
  361.    if vWindowOn then
  362.    begin
  363.       vWindowOn := false;
  364.       WinCursX := WhereX;
  365.       WinCursY := WhereY;
  366.       if Monitor^.BaseofScreen = vScreenPtr then  {1.00d}
  367.       begin
  368.          GetCursorPos;  {1.00g}
  369.          CRT.window(1,1,Monitor^.Width,Monitor^.Depth);
  370.          SetCursorPos;  {1.00g}
  371.       end;
  372.       WindowOff := true;
  373.    end
  374.    else
  375.       WindowOff := false;
  376. end; {WriteOBJ.WindowOff}
  377.  
  378. procedure WriteOBJ.WindowOn;
  379. {}
  380. begin
  381.    vWindowOn := true;
  382.    window(vWindow.X1,vWindow.Y1,vWindow.X2,vWindow.Y2);
  383.    GotoXY(WinCursX,WinCursY);
  384. end; {WriteOBJ.WindowOn}
  385.  
  386. procedure WriteOBJ.WindowCoords(var Coords: tByteCoords);
  387. {}
  388. begin
  389.    Coords := vWindow;
  390. end; {WriteOBJ.WindowCoords}
  391.  
  392. function WriteOBJ.WindowActive: boolean;
  393. {}
  394. begin
  395.    WindowActive := vWindowOn;
  396. end; {WriteOBJ.WindowActive}
  397.  
  398. function WriteOBJ.WindowInEffect: boolean;
  399. {}
  400. begin
  401.    WindowInEffect := vWindowOn and not vWindowIgnore;
  402. end; {WriteOBJ.WindowActive}
  403.  
  404. procedure WriteOBJ.SetWinIgnore(On:Boolean);
  405. {}
  406. begin
  407.    vWindowIgnore := On;
  408. end; {WriteOBJ.SetWinIgnore}
  409.  
  410. function WriteOBJ.WinX: byte;
  411. {}
  412. begin
  413.    if vWindowOn and not vWindowIgnore then
  414.       WinX := vWindow.X1
  415.    else
  416.       WinX := 1;
  417. end; {WriteOBJ.WinX}
  418.  
  419. function WriteOBJ.WinY: byte;
  420. {}
  421. begin
  422.    if vWindowOn and not vWindowIgnore then
  423.       WinY := vWindow.Y1
  424.    else
  425.       WinY := 1;
  426. end; {WriteOBJ.WinY}
  427.  
  428. procedure WriteOBJ.WriteAT(X,Y,attr:byte;Str:string);
  429. {}
  430. begin
  431.    if not vWindowOn or vWindowIgnore then
  432.       ASMWrite(vScreenPtr^,vWidth,X,Y,attr,Str)
  433.    else
  434.    begin
  435.       Str := copy(Str,1,vWindow.X2 - pred(X) - pred(vWindow.X1));
  436.       if Y + pred(vWindow.Y1) <= vWindow.Y2 then
  437.          ASMWrite(vScreenPtr^,vWidth,pred(vWindow.X1)+X,
  438.                                         pred(vWindow.Y1)+Y,
  439.                                         attr,Str);
  440.    end;
  441. end; {WriteOBJ.WriteAT}
  442.  
  443. procedure WriteOBJ.WritePlain(X,Y:byte;Str:string);
  444. {}
  445. begin
  446.    if not vWindowOn or vWindowIgnore then
  447.       ASMPWrite(vScreenPtr^,vWidth,X,Y,Str)
  448.    else
  449.    begin
  450.       Str := copy(Str,1,vWindow.X2 - pred(X) - pred(vWindow.X1));
  451.       if Y + pred(vWindow.Y1) <= vWindow.Y2 then
  452.          ASMPWrite(vScreenPtr^,vWidth,pred(vWindow.X1)+X,
  453.                                         pred(vWindow.Y1)+Y,
  454.                                         Str);
  455.    end;
  456. end; {WriteOBJ.WritePlain}
  457.  
  458. procedure WriteOBJ.Write(Str:string);
  459. {}
  460. begin
  461.    if Monitor^.BaseofScreen = vScreenPtr then
  462.       System.Write(Str)
  463.    else
  464.    begin
  465.  
  466.    end;
  467. end; {WriteOBJ.Write}
  468.  
  469. procedure WriteOBJ.WriteLn(Str:string);
  470. {}
  471. begin
  472.    System.WriteLn(Str);
  473. end; {WriteOBJ.WriteLn}
  474.  
  475. procedure WriteOBJ.GetCursorPos;
  476. {}
  477. var Regs: Registers;
  478. begin
  479.    with Regs do
  480.    begin
  481.       AH := 3;
  482.       BH := 0;
  483.    end;
  484.    Intr($10,Regs);
  485.    vTempY := Regs.DH;
  486.    vTempX := Regs.DL;
  487. end; {WriteOBJ.GetCursorPos}
  488.  
  489. procedure WriteOBJ.SetCursorPos;
  490. {}
  491. var
  492.   Regs: Registers;
  493. begin
  494.    with Regs do
  495.    begin
  496.       AH := 2;
  497.       BH := 0;
  498.       DH := vTempY;
  499.       DL := vTempX;
  500.    end;
  501.    Intr($10,Regs);
  502. end; {WriteOBJ.SetCursorPos}
  503.  
  504. procedure WriteOBJ.GotoXY(X,Y: word);
  505. {}
  506. var Regs: Registers;
  507. begin
  508.    if vWindowOn and vWindowIgnore then
  509.    begin
  510.       with Regs do
  511.       begin
  512.          AH := 2;
  513.          DH := pred(Y);
  514.          DL := pred(X);
  515.          BH := 0;
  516.       end;
  517.       Intr($10,Regs);
  518.    end
  519.    else
  520.       CRT.GotoXY(X,Y);
  521. end; {WriteOBJ.GotoXY}
  522.  
  523. function  WriteOBJ.WhereX: word;
  524. {}
  525. begin
  526.    WhereX := CRT.WhereX;
  527. end; {WriteOBJ.WhereX}
  528.  
  529. function  WriteOBJ.WhereY: word;
  530. {}
  531. begin
  532.    WhereY := CRT.WhereY;
  533. end; {WriteOBJ.WhereY}
  534.  
  535. procedure WriteOBJ.ChangeAttr(X,Y,Att:byte;Len:word);
  536. {}
  537. begin
  538.    if not vWindowOn or vWindowIgnore then
  539.       ASMAttr(vScreenPtr^,vWidth,X,Y,Att,Len)
  540.    else
  541.    begin
  542.       inc(X,pred(vWindow.X1));
  543.       inc(Y,pred(vWindow.Y1));
  544.       if (X <= vWindow.X2) and (Y <= vWindow.Y2) then
  545.       begin
  546.          if X + Len > vWindow.X2 then
  547.             Len := vWindow.X2 - pred(X);
  548.          ASMAttr(vScreenPtr^,vWidth,X,Y,Att,Len)
  549.       end;
  550.    end;
  551. end; {WriteOBJ.ChangeAttr}
  552.  
  553. procedure WriteOBJ.MoveFromScreen(var Source,Dest;Len:Word);
  554. {}
  555. begin
  556.    ASMMoveFromScreen(Source,Dest,Len);
  557. end; {WriteOBJ.MoveFromScreen}
  558.  
  559. procedure WriteOBJ.MoveToScreen(var Source,Dest; Len:Word);
  560. {}
  561. begin
  562.    ASMMoveToScreen(Source,Dest,Len);
  563. end; {WriteOBJ.MoveToScreen}
  564.  
  565. procedure WriteOBJ.Clear(Att:byte;Ch:char);                              
  566. {}
  567. var
  568.    I : integer;
  569.    S : string;
  570. begin
  571.    with vWindow do
  572.    begin
  573.        S := Replicate(Succ(X2-X1),Ch);
  574.        for I := 1 to succ(Y2-Y1) do
  575.        begin
  576.           ChangeAttr(X1,Y1,Att,succ(X2-X1));
  577.           WritePlain(1,I,S);
  578.        end;
  579.    end;
  580. end; {WriteOBJ.Clear}
  581.  
  582. destructor WriteOBJ.Done;
  583. {}
  584. begin 
  585. end; {WriteOBJ.Done}
  586. {|||||||||||||||||||||||||||||||||||||||||||}
  587. {                                           }
  588. {     S c r e e n O B J   M E T H O D S     }
  589. {                                           }
  590. {|||||||||||||||||||||||||||||||||||||||||||}
  591. constructor ScreenOBJ.Init;
  592. {}
  593. begin
  594.    vScreenPtr := nil;
  595.    vHiMarker := '~';
  596.    vVisible := false;
  597.    vOnScreen := false;
  598.    New(oWritePtr,Init);
  599.    oWritePtr^.SetScreen(vScreenPtr,vWidth);
  600.    ResetWindow;
  601. end; {ScreenOBJ.Init}
  602.  
  603. procedure ScreenOBJ.SetHiMarker(M:char);
  604. {}
  605. begin
  606.    vHiMarker := M;
  607. end; {ScreenOBJ.SetHiMarker}
  608.  
  609. function ScreenOBJ.HiMarker:char;
  610. {}
  611. begin
  612.    Himarker := vHiMarker;
  613. end; {ScreenOBJ.Himarker}
  614.  
  615. procedure ScreenOBJ.AssignWriteOBJ(var Wri: WriteOBJ);
  616. {}
  617. begin
  618.    Dispose(oWritePtr,Done);
  619.    oWritePtr := @Wri;
  620.    oWritePtr^.SetScreen(vScreenPtr,vWidth);
  621. end; {ScreenOBJ.AssignWriteOBJ}
  622.  
  623. procedure ScreenOBJ.SetWindow(X1,Y1,X2,Y2: byte);
  624. {}
  625. begin
  626.    oWritePtr^.SetWindow(X1,Y1,X2,Y2);
  627. end; {ScreenOBJ.SetWindow}
  628.  
  629. procedure ScreenOBJ.SetWinIgnore(On:Boolean);
  630. {}
  631. begin
  632.    oWritePtr^.SetWinIgnore(On);
  633. end; {ScreenOBJ.SetWinIgnore}
  634.  
  635. procedure ScreenOBJ.ResetWindow;
  636. {}
  637. begin
  638.    oWritePtr^.ResetWindow;
  639. end; {ScreenOBJ.ResetWindow}
  640.  
  641. function ScreenOBJ.WindowOff:boolean;
  642. {}
  643. begin
  644.    WindowOff := oWritePtr^.WindowOff;
  645. end; {ScreenOBJ.WindowOff}
  646.  
  647. procedure ScreenOBJ.WindowOn;
  648. {}
  649. begin
  650.    oWritePtr^.WindowOn;
  651. end; {ScreenOBJ.WindowOn}
  652.  
  653. procedure ScreenOBJ.WindowCoords(var Coords: tByteCoords);
  654. {}
  655. begin
  656.    oWritePtr^.WindowCoords(Coords);
  657. end; {ScreenOBJ.WindowCoords}
  658.  
  659. function ScreenOBJ.WindowActive: boolean;
  660. {}
  661. begin
  662.    WindowActive := oWritePtr^.WindowActive;
  663. end; {ScreenOBJ.WindowActive}
  664. {|||||||||||||||||||||||||||||||||}
  665. {     C U R S O R   S T U F F     }
  666. {|||||||||||||||||||||||||||||||||}
  667. function ScreenOBJ.OnScreen: boolean;
  668. {is this instance the visible screen}
  669. begin
  670.    OnScreen := vOnScreen;
  671. end; {ScreenOBJ.OnScreen}
  672.  
  673. function ScreenOBJ.CharHeight: integer;
  674. {get height of text mode characters for cursor manipulation}
  675. var
  676.    Regs: Registers;
  677. begin
  678.    if OnScreen then
  679.    begin
  680.       case Monitor^.DisplayType of
  681.       Mono: CharHeight := 14;
  682.       EGACol,
  683.       CGA : CharHeight := 8;
  684.       else
  685.          with Regs do
  686.          begin
  687.             Ah := $11;
  688.             Al := $30;
  689.             BX := $0;
  690.             Intr($10,Regs);
  691.             CharHeight := CX;
  692.          end; {with}
  693.       end;  {case}
  694.    end
  695.    else        {virtual screen assume normal mode}
  696.    begin
  697.       if Monitor^.DisplayType = Mono then
  698.          CharHeight := 14
  699.       else
  700.          CharHeight := 8;
  701.    end;
  702. end; {ScreenOBJ.CharHeight}
  703.  
  704. procedure ScreenOBJ.CursReset;
  705. {}
  706. begin
  707.    GotoXY(1,1);
  708.    CursOn;
  709. end; {ScreenOBJ.CursReset}
  710.  
  711. procedure ScreenOBJ.CursSave;
  712. {updates instance with visible Cursor details}
  713. var Reg : registers;
  714. begin
  715.    with Reg do
  716.    begin
  717.       Ax := $0F00; {get page in Bx}
  718.       intr($10,reg);
  719.       Ax := $0300;
  720.       intr($10,reg);
  721.       vCursX := lo(Dx) + 1;
  722.       vCursY := hi(Dx) + 1;
  723.       vCursTop := Hi(Cx) and $0F;
  724.       vCursBot := Lo(Cx) and $0F;
  725.    end;
  726. end; {ScreenOBJ.CursSave}
  727.  
  728. procedure ScreenOBJ.CursSize(T,B : byte);
  729. {}
  730. var Reg: registers;
  731. begin
  732.    if OnScreen then {writing to a visible screen}
  733.    begin
  734.       with reg do
  735.       begin
  736.          AX := $0100;
  737.          if (T=0) and (B=0) then
  738.             CX := $2020         {Thanks Yaron!! 1.00e}
  739.          else
  740.          begin
  741.          (*  
  742.          If you have an odd video bios and cursor changes
  743.          are strange, enable this next line.
  744.             mem[$40:$87] := mem[$40:$87] or $01; {get cursor ownership from BIOS}
  745.          *)
  746.             Ch := T;
  747.             Cl := B;
  748.          end;
  749.          intr($10,Reg);
  750.       end;
  751.    end;
  752.    vCursTop := T;
  753.    vCursBot := B;
  754. end; {ScreenOBJ.CursSize}
  755.  
  756. function ScreenOBJ.WhereX: word;
  757. {}
  758. begin
  759.    if OnScreen then {writing to a visible screen}
  760.       WhereX := oWritePtr^.WhereX
  761.    else
  762.       WhereX := vCursX;
  763. end; {ScreenOBJ.WhereX}
  764.  
  765. function ScreenOBJ.WhereY: word;
  766. {}
  767. begin
  768.    if OnScreen then {writing to a visible screen}
  769.       WhereY := oWritePtr^.WhereY
  770.    else
  771.       WhereY := vCursY;
  772. end; {ScreenOBJ.WhereY}
  773.  
  774. procedure ScreenOBJ.GotoXY(X,Y:word);
  775. {}
  776. begin
  777.    if OnScreen then {writing to a visible screen}
  778.       oWritePtr^.GotoXY(X,Y)
  779.    else
  780.    begin
  781.       vCursX := X;
  782.       vCursY := Y;
  783.    end;
  784. end; {ScreenOBJ.CursGotoXY}
  785.  
  786. function ScreenOBJ.CursTop: byte;
  787. {}
  788. begin
  789.    CursTop := vCursTop;
  790. end; {ScreenOBJ.CursTOP}
  791.  
  792. function ScreenOBJ.CursBot: byte;
  793. {}
  794. begin
  795.    CursBot := vCursBot;
  796. end; {ScreenOBJ.CursBot}
  797.  
  798. procedure ScreenOBJ.CursHalf;
  799. {}
  800. var Charsize: byte;
  801. begin
  802.    CharSize := CharHeight;
  803.    CursSize(CharSize div 2, pred(CharSize));
  804. end; {ScreenOBJ.CursHalf}
  805.  
  806. procedure ScreenOBJ.CursFull;
  807. {}
  808. var Charsize: byte;
  809. begin
  810.    CharSize := CharHeight;
  811.    CursSize(0,CharSize);
  812. end; {ScreenOBJ.CursFull}
  813.  
  814. procedure ScreenOBJ.CursOn;
  815. {}
  816. var Charsize: byte;
  817. begin
  818.    CharSize := CharHeight;
  819.    CursSize(CharSize-3, CharSize-2);
  820. end; {ScreenOBJ.CursOn}
  821.  
  822. procedure ScreenOBJ.CursOff;
  823. {}
  824. begin
  825.    CursSize(0,0);
  826. end; {ScreenOBJ.CursOff}
  827. {||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  828. {     S C R E E N    S A V E    &    R E S T O R E     }
  829. {||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  830. procedure ScreenOBJ.Exists;
  831. {makes sure there is a screen on the heap}
  832. begin
  833.    if ScreenPtr = nil then
  834.       Error(2);
  835. end; {ScreenOBJ.Exists}
  836.  
  837. procedure ScreenOBJ.Create(X,Y,Attr:byte);
  838. {}
  839. var MemoryNeeded: longint;
  840. begin
  841.    MemoryNeeded := X*Y*2;
  842.    If MaxAvail < MemoryNeeded then
  843.       Error(1)
  844.    else
  845.    begin
  846.       If (X = 0) and (Y = 0) then    {map to physical screen}
  847.       begin
  848.          vWidth := Monitor^.Width;
  849.          (*
  850.          vDepth := 50;              {set to max for extended line displays}
  851.          *)
  852.          vDepth := Monitor^.Depth;
  853.          vVisible := true;
  854.          vScreenPtr := Monitor^.BaseOfScreen; {1.00a}
  855.          oWritePtr^.SetScreen(vScreenPtr,vWidth);
  856.          vOnScreen := true;
  857.          CursSave;
  858.          ResetWindow;
  859.       end
  860.       else
  861.       begin
  862.          vWidth := X;
  863.          vDepth := Y;
  864.          GetMem(vScreenPtr,MemoryNeeded);
  865.          oWritePtr^.SetScreen(vScreenPtr,vWidth);
  866.          SetWindow(1,1,X,Y);
  867.          Clear(Attr,' ');
  868.          CursReset;
  869.       end;
  870.    end;
  871. end; {ScreenOBJ.Create}
  872.  
  873. procedure ScreenOBJ.MoveFromScreen(var Source, Dest; Length:word);
  874. {}
  875. begin
  876.    oWritePtr^.MoveFromScreen(Source,Dest,Length);
  877. end; {ScreenOBJ.MoveFromScreen}
  878.  
  879. procedure ScreenOBJ.MoveToScreen(var Source, Dest; Length:word);
  880. {}
  881. begin
  882.    oWritePtr^.MoveToScreen(Source,Dest,Length);
  883. end; {ScreenOBJ.MoveToScreen}
  884.  
  885. procedure ScreenOBJ.Save;
  886. {saves current screen to instance}
  887. var 
  888.   MemoryNeeded: longint;
  889.   MVisible: boolean;
  890.   WinCoords: tByteCoords;
  891. begin
  892.    If ScreenPtr <> nil then
  893.       Freemem(vScreenPtr,Width*Depth*2);
  894.    MemoryNeeded := Monitor^.Width*Monitor^.Depth*2;
  895.    If MaxAvail < MemoryNeeded then
  896.       Error(1)
  897.    else
  898.    begin
  899.       vWidth := Monitor^.Width;
  900.       vDepth := Monitor^.Depth;
  901.       GetMem(vScreenPtr,MemoryNeeded);
  902.       MVisible := Mouse.Visible;
  903.       if MVisible then
  904.          Mouse.Hide;
  905.       MoveFromScreen(Monitor^.BaseOfScreen^,ScreenPtr^,vWidth*vDepth);
  906.       CursSave;
  907.       oWritePtr^.SetScreen(vScreenPtr,vWidth);
  908.       Screen.WindowCoords(WinCoords);
  909.       with WinCoords do
  910.          SetWindow(X1,Y1,X2,Y2); 
  911.       if MVisible then
  912.          Mouse.Show;
  913.    end;
  914. end; {ScreenOBJ.Save}
  915.  
  916. function ScreenOBJ.Width: byte;
  917. {}
  918. begin
  919.    Width := vWidth;
  920. end; {ScreenOBJ.Width}
  921.  
  922. function ScreenOBJ.Depth: byte;
  923. {}
  924. begin
  925.    if vVisible then
  926.    begin
  927.       Depth := Monitor^.Depth
  928.    end
  929.    else
  930.       Depth := vDepth;
  931. end; {ScreenOBJ.Depth}
  932.  
  933. function ScreenOBJ.ScreenPtr: pointer;
  934. {}
  935. begin
  936.    ScreenPtr := vScreenPtr;
  937. end; {ScreenOBJ.ScrPtr}
  938.  
  939. procedure ScreenOBJ.Display;
  940. {}
  941. var 
  942.   Wid,Dep:byte;
  943.   MVisible:boolean;
  944.   WinCoords: tByteCoords;
  945. begin
  946. {$IFNDEF FINAL}
  947.    Exists;
  948. {$ENDIF}
  949.    MVisible := Mouse.Visible;
  950.    if MVisible then
  951.       Mouse.Hide;
  952.    if Width = Monitor^.Width then  {one big move}
  953.       MoveToScreen(ScreenPtr^,Monitor^.BaseOfScreen^, width*Monitor^.Depth)
  954.    else
  955.    begin
  956.       Wid := Monitor^.Width;
  957.       if Wid > vWidth then
  958.          Wid := vWidth;
  959.       Dep := Monitor^.Depth;
  960.       if Dep > vDepth then
  961.          Dep := vDepth;
  962.       PartDisplay(1,1,Wid,Dep,1,1);
  963.    end;
  964.    {now restore cursor details}
  965.    WindowCoords(WinCoords);
  966.    with WinCoords do
  967.       Screen.SetWindow(X1,Y1,X2,Y2);
  968.    Screen.GotoXY(WhereX,WhereY);
  969.    Screen.CursSize(CursTop,CursBot);
  970.    if MVisible then           (* Change to restore Mouse Details *)
  971.       Mouse.Show;
  972. end; {ScreenOBJ.Display}
  973.  
  974. procedure ScreenOBJ.PartDisplay(X1,Y1,X2,Y2,X,Y:byte);
  975. {}
  976. var
  977.    MonitorWidth,
  978.    ScreenWidth,
  979.    SectionWidth   : byte;
  980.    I              : integer;
  981.    VisibleAdr,
  982.    VirtualAdr     : word;
  983.    VisiblePtr,
  984.    VirtualPtr     : pointer;
  985.    MVisible:boolean;
  986. begin
  987.    if X2 > vWidth then
  988.       X2 := vWidth;
  989.    if Y2 > vDepth then
  990.       Y2 := vDepth;
  991.    SectionWidth := succ(X2- X1);
  992.    MonitorWidth := Monitor^.Width;
  993.    ScreenWidth  := Width;
  994.    VirtualPtr := ScreenPtr;
  995.    VisiblePtr := Monitor^.BaseOfScreen;
  996.    MVisible := Mouse.Visible;
  997.    if MVisible then
  998.       Mouse.Hide;
  999.    For I :=  Y1 to Y2 do
  1000.    begin
  1001.        VisibleAdr := pred(Y+I-Y1)*MonitorWidth*2 + pred(X)*2;
  1002.        VirtualAdr := pred(I)*ScreenWidth*2 + Pred(X1)*2;
  1003.        MoveToScreen(Mem[Seg(VirtualPtr^):ofs(VirtualPtr^)+VirtualAdr],
  1004.                     Mem[Seg(VisiblePtr^):ofs(VisiblePtr^)+VisibleAdr],
  1005.                     Sectionwidth);
  1006.    end;
  1007.    if MVisible then
  1008.       Mouse.Show;
  1009. end; {ScreenOBJ.PartDisplay}
  1010.  
  1011. procedure ScreenOBJ.PartSlideDisplay(X1,Y1,X2,Y2:byte;Way:tDirection);
  1012. {}
  1013. var
  1014.    I : integer;
  1015. begin
  1016.    Case Way of
  1017.    Up    : begin
  1018.               for I := Y2 downto Y1 do
  1019.               begin
  1020.                   PartDisplay(X1,Y1,X2,Y1+Y2-I,X1,I);
  1021.                   Delay(50);
  1022.               end;
  1023.            end;
  1024.    Down  : begin
  1025.               for I := Y1 to Y2 do
  1026.               begin
  1027.                   PartDisplay(X1,Y1+Y2 -I,X2,Y2,X1,Y1);
  1028.                   Delay(50);  {savor the moment!}
  1029.               end;
  1030.            end;
  1031.    Left  : begin
  1032.               for I := X1 to X2 do
  1033.               begin
  1034.                   PartDisplay(X1,Y1,I,Y2,X1+X2-I,Y1);
  1035.               end;
  1036.            end;
  1037.    Right : begin
  1038.               for I := X2 downto X1 do
  1039.               begin
  1040.                   PartDisplay(I,Y1,X2,Y2,X1,Y1);
  1041.               end;
  1042.            end;
  1043.    Vert:   for I := Y1 to Y1 + (Y2 - Y1) div 2 do
  1044.            begin
  1045.               PartDisplay(X1,I,X2,I,X1,I);
  1046.               PartDisplay(X1,Y2+Y1-I,X2,Y2+Y1-I,X1,Y2+Y1-I);
  1047.               Delay(50);
  1048.            end;
  1049.    Horiz:  for I := X1 to X1 + succ(X2 -X1) div 2 do
  1050.            begin
  1051.               PartDisplay(I,Y1,I,Y2,I,Y1);
  1052.               PartDisplay((X2)+X1-I,Y1,(X2)+X1-I,Y2,(X2)+X1-I,Y1);
  1053.               Delay(10);
  1054.            end;
  1055.    end; {case}
  1056. end; {ScreenOBJ.PartSlideDisplay}
  1057.  
  1058. procedure ScreenOBJ.SlideDisplay(Way: tDirection);
  1059. {}
  1060. var
  1061.   WinCoords: tByteCoords;
  1062.   X,Y,Top,Bot : byte;
  1063. begin
  1064.    X := Monitor^.Width;
  1065.    if X > vWidth then
  1066.       X := vWidth;
  1067.    Y := Monitor^.Depth;
  1068.    if Y > vDepth then
  1069.       Y := vDepth;
  1070.    PartSlideDisplay(1,1,X,Y,Way);
  1071.    {now restore cursor details}
  1072.    X := WhereX;
  1073.    Y := WhereY;
  1074.    Top := CursTop;
  1075.    Bot := CursBot;
  1076.    Screen.SetWindow(1,1,Monitor^.Width,Monitor^.Depth); {1.00g}
  1077.    Screen.GotoXY(X,Y);
  1078.    Screen.CursSize(Top,Bot);
  1079.    WindowCoords(WinCoords);
  1080.    with WinCoords do
  1081.       Screen.SetWindow(X1,Y1,X2,Y2);
  1082. end; {ScreenOBJ.SlideDisplay}
  1083.  
  1084. procedure ScreenOBJ.PartSave (X1,Y1,X2,Y2:byte; VAR Dest);
  1085. {transfers data from active virtual screen to Dest}
  1086. var
  1087.    I,wid : byte;
  1088.    ScreenAdr: integer;
  1089.    MVisible: boolean;
  1090. begin
  1091.    wid := succ(X2- X1);
  1092.    MVisible := Mouse.Visible;
  1093.    if MVisible then
  1094.       Mouse.Hide;
  1095.    For I :=  Y1 to Y2 do
  1096.    begin
  1097.       ScreenAdr := Pred(I)*160 + Pred(X1)*2;
  1098.       MoveFromScreen(Mem[seg(vScreenPtr^):ofs(vScreenPtr^)+ScreenAdr],
  1099.                      Mem[seg(Dest):ofs(dest)+(I-Y1)*wid*2],
  1100.                      wid);
  1101.    end;
  1102.    if MVisible then
  1103.       Mouse.Show;
  1104. end; {ScreenOBJ.PartSave}
  1105.  
  1106. procedure ScreenOBJ.PartRestore (X1,Y1,X2,Y2:byte; VAR Source);
  1107. {restores data from Source and transfers to active virtual screen
  1108.  - used internally}
  1109. var
  1110.    I,wid : byte;
  1111.    ScreenAdr: integer;
  1112.    MVisible: boolean;
  1113. begin
  1114.    wid := succ(X2- X1);
  1115.    MVisible := Mouse.Visible;
  1116.    if MVisible then
  1117.       Mouse.Hide;
  1118.    For I :=  Y1 to Y2 do
  1119.    begin
  1120.     ScreenAdr := Pred(I)*160 + Pred(X1)*2;
  1121.     MoveToScreen(Mem[Seg(Source):ofs(Source)+(I-Y1)*wid*2],
  1122.                  Mem[seg(vScreenPtr^):ofs(vScreenPtr^)+ScreenAdr],
  1123.                  wid);
  1124.    end;
  1125.    if MVisible then
  1126.      Mouse.Show;
  1127. end; {ScreenOBJ.PartRestore}
  1128.  
  1129. procedure ScreenOBJ.CopyScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  1130. {copies text and attributes from one part of screen to another}
  1131. Var
  1132.    S : word;
  1133.    SPtr : pointer;
  1134.    MVisible: boolean;
  1135. begin
  1136.     S := succ(Y2-Y1)*succ(X2-X1)*2;
  1137.     If Maxavail < S then
  1138.        Error(3)
  1139.     else
  1140.     begin
  1141.        MVisible := Mouse.Visible;
  1142.        if MVisible then
  1143.           Mouse.Hide;
  1144.        GetMem(SPtr,S);
  1145.        PartSave(X1,Y1,X2,Y2,SPtr^);
  1146.        PartRestore(X,Y,X+X2-X1,Y+Y2-Y1,SPtr^);
  1147.        FreeMem(Sptr,S);
  1148.        if MVisible then
  1149.           Mouse.Show;
  1150.     end;
  1151. end; {ScreenOBJ.CopyScreenBlock}
  1152.  
  1153. procedure ScreenOBJ.MoveScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  1154. {Moves text and attributes from one part of screen to another,
  1155.  replacing with Replace_Char}
  1156. const
  1157.   Replace_Char = ' ';
  1158. Var
  1159.    S : word;
  1160.    SPtr : pointer;
  1161.    I : Integer;
  1162.    ST : string;
  1163.    MVisible: boolean;
  1164. begin
  1165.     S := succ(Y2-Y1)*succ(X2-X1)*2;
  1166.     If Maxavail < S then
  1167.        Error(3)
  1168.     else
  1169.     begin
  1170.        MVisible := Mouse.Visible;
  1171.        if MVisible then
  1172.           Mouse.Hide; 
  1173.        GetMem(SPtr,S);
  1174.        PartSave(X1,Y1,X2,Y2,SPtr^);
  1175.        St := Replicate(succ(X2-X1),Replace_Char);
  1176.        For I := Y1 to Y2 do
  1177.            WritePlain(X1,I,St);
  1178.        PartRestore(X,Y,X+X2-X1,Y+Y2-Y1,SPtr^);
  1179.        FreeMem(Sptr,S);
  1180.        if MVisible then
  1181.           Mouse.Show;
  1182.     end;
  1183. end; {ScreenOBJ.MoveScreenBlock}
  1184.  
  1185. procedure ScreenOBJ.Scroll(Way:tDirection;X1,Y1,X2,Y2:byte);
  1186. {used for screen scrolling, uses Copy & Plainwrite for speed}
  1187. const
  1188.   Replace_Char = ' ';
  1189. var
  1190.   I : integer;
  1191. begin
  1192.     Case Way of
  1193.     Up   : begin
  1194.                CopyScreenBlock(X1,succ(Y1),X2,Y2,X1,Y1);
  1195.                WritePlain(X1,Y2,replicate(succ(X2-X1),Replace_Char));
  1196.            end;
  1197.     Down : begin
  1198.                CopyScreenBlock(X1,Y1,X2,pred(Y2),X1,succ(Y1));
  1199.                WritePlain(X1,Y1,replicate(succ(X2-X1),Replace_Char));
  1200.            end;
  1201.     Left : begin
  1202.                CopyScreenBlock(succ(X1),Y1,X2,Y2,X1,Y1);
  1203.                For I := Y1 to Y2 do
  1204.                    WritePlain(X2,I,Replace_Char);
  1205.            end;
  1206.     Right: begin
  1207.                CopyScreenBlock(X1,Y1,pred(X2),Y2,succ(X1),Y1);
  1208.                For I := Y1 to Y2 do
  1209.                    WritePlain(X1,I,Replace_Char);
  1210.            end;
  1211.     end; {case}
  1212. end; {ScreenOBJ.Scroll}
  1213. {||||||||||||||||||||||||||||||||||||}
  1214. {     S C R E E N    W R I T E S     }
  1215. {||||||||||||||||||||||||||||||||||||}
  1216. procedure ScreenOBJ.Write(Str:string);
  1217. {write at the cursor position using the default attributes, and
  1218.  moves cursor to end of string}
  1219. var 
  1220.    NewX: integer; {1.00c}
  1221.    X,Y:byte;
  1222.    MVisible: boolean;
  1223. begin
  1224. {$IFNDEF FINAL}
  1225.    Exists;
  1226. {$ENDIF}
  1227.    MVisible := Mouse.Visible and vOnScreen;  {1.00c}
  1228.    X := WhereX + pred(oWritePtr^.WinX);
  1229.    Y := WhereY + pred(oWritePtr^.WinY);
  1230.    if MVisible and Mouse.InZone(X,Y,X+length(Str),Y) then
  1231.    begin
  1232.       Mouse.Hide;
  1233.       oWritePtr^.Write(Str);
  1234.       Mouse.Show;
  1235.    end
  1236.    else if vOnScreen then {1.00c}
  1237.       oWritePtr^.Write(Str)
  1238.    else
  1239.    begin
  1240.       oWritePtr^.WritePlain(vCursX,vCursY,Str);
  1241.       NewX := vCursX + length(Str);
  1242.       vCursX := NewX mod vWidth;
  1243.       inc(vCursY,NewX div vWidth);
  1244.    end;
  1245. end; {ScreenOBJ.Write}
  1246.  
  1247. procedure ScreenOBJ.WriteLn(Str:string);
  1248. {write at the cursor position using the default attributes, and
  1249.  moves cursor to next line}
  1250. var
  1251.    X,Y:integer;
  1252.    MVisible: boolean;
  1253. begin
  1254. {$IFNDEF FINAL}
  1255.    Exists;
  1256. {$ENDIF}
  1257.    MVisible := Mouse.Visible and vOnScreen;  {1.00c}
  1258.    X := WhereX + pred(oWritePtr^.WinX);
  1259.    Y := WhereY + pred(oWritePtr^.WinY);
  1260.    if MVisible and Mouse.InZone(X,Y,X+length(Str),Y) then
  1261.    begin
  1262.       Mouse.Hide;
  1263.       oWritePtr^.WriteLn(Str);
  1264.       Mouse.Show;
  1265.    end
  1266.    else if vOnScreen then {1.00c}
  1267.       oWritePtr^.WriteLn(Str)
  1268.    else
  1269.    begin
  1270.       oWritePtr^.WritePlain(vCursX,vCursY,Str);
  1271.       vCursX := 1;
  1272.       inc(vCursY);
  1273.    end;
  1274. end; {ScreenOBJ.WriteLn}
  1275.  
  1276. procedure ScreenOBJ.WriteAT(X,Y,attr:byte;Str:string);
  1277. {}
  1278. var
  1279.    MVisible: boolean;
  1280.    GlobalX,GlobalY: byte;
  1281. begin
  1282. {$IFNDEF FINAL}                  
  1283.    Exists;                       
  1284. {$ENDIF}
  1285.    if Attr = 0 then
  1286.       WritePlain(X,Y,Str)
  1287.    else   
  1288.    begin
  1289.       MVisible := Mouse.Visible and vOnScreen;  {1.00c}
  1290.       GlobalX := X + pred(oWritePtr^.WinX);
  1291.       GlobalY := Y + pred(oWritePtr^.WinY);
  1292.       if MVisible and Mouse.InZone(GlobalX,GlobalY,GlobalX+length(Str),GlobalY) then
  1293.       begin
  1294.          Mouse.Hide;
  1295.          oWritePtr^.WriteAT(X,Y,attr,Str);
  1296.          Mouse.Show;
  1297.       end
  1298.       else
  1299.          oWritePtr^.WriteAT(X,Y,attr,Str);
  1300.    end;
  1301. end; {ScreenOBJ.WriteAT}
  1302.  
  1303. procedure ScreenOBJ.WriteHi(X,Y,AttrHi,Attr:byte;Str:string);
  1304. {}
  1305. var 
  1306.   P:byte;
  1307.   Hi : Boolean;
  1308.  
  1309.      procedure WriteBit(Str:string);
  1310.      begin
  1311.         if Hi then
  1312.            WriteAt(X,Y,AttrHi,Str)
  1313.         else
  1314.            WriteAt(X,Y,Attr,Str);
  1315.      end;
  1316.  
  1317. begin
  1318.    Hi := False;
  1319.    P := Pos(vHiMarker,Str);
  1320.    While P <> 0 do
  1321.    begin
  1322.        if P > 1 then
  1323.           WriteBit(copy(Str,1,pred(P)));
  1324.        Delete(Str,1,P);
  1325.        inc(X,pred(P));
  1326.        P := Pos(vHiMarker,Str);
  1327.        Hi := not Hi;
  1328.    end;
  1329.    WriteBit(Str);
  1330. end; {ScreenOBJ.WriteHi}
  1331.  
  1332. procedure ScreenOBJ.WritePlain(X,Y:byte;Str:string);
  1333. {}
  1334. var
  1335.    MVisible: boolean;
  1336.    GlobalX,GlobalY: byte;
  1337. begin
  1338. {$IFNDEF FINAL}
  1339.    Exists;
  1340. {$ENDIF}
  1341.    MVisible := Mouse.Visible and vOnScreen;  {1.00c}
  1342.    GlobalX := X + pred(oWritePtr^.WinX);
  1343.    GlobalY := Y + pred(oWritePtr^.WinY);
  1344.    if MVisible and Mouse.InZone(GlobalX,GlobalY,GlobalX+length(Str),GlobalY) then
  1345.    begin
  1346.       Mouse.Hide;
  1347.       oWritePtr^.WritePlain(X,Y,Str);
  1348.       Mouse.Show;
  1349.    end
  1350.    else
  1351.       oWritePtr^.WritePlain(X,Y,Str);
  1352. end; {ScreenOBJ.WritePlain}
  1353.  
  1354. procedure ScreenOBJ.WriteCap(X,Y,AttrCap,Attr:byte;Str:string);
  1355. {Writes a string with the first capital letter in a different color}
  1356. var
  1357.   CapPos : byte;
  1358. begin
  1359.    If Str <> '' then
  1360.    begin
  1361.       WriteAt(X,Y,Attr,Str);   {write whole string in default cols}
  1362.       CapPos := 1;
  1363.       While (CapPos <= length(Str))
  1364.       and   ((Str[CapPos] in [#65..#90]) = false) do
  1365.          inc(CapPos);
  1366.       If CapPos <= length(Str) then
  1367.          WriteAt(X + pred(CapPos),Y,AttrCap,Str[CapPos]);
  1368.    end;
  1369. end; {ScreenOBJ.WriteCap}
  1370.  
  1371. procedure ScreenOBJ.WriteClick(X,Y,attr:byte;Str:string);
  1372. {writes text to the screen with a click!}
  1373. var
  1374.   I : Integer;
  1375.   L : byte;
  1376. begin
  1377.    L := length(Str);
  1378.    If OnScreen then
  1379.       for I := L downto 1 do
  1380.       begin
  1381.          WriteAt(X,Y,Attr,copy(Str,I,succ(L-I)));
  1382.          sound(500);delay(20);nosound;delay(30);
  1383.       end
  1384.    else
  1385.       WriteAt(X,Y,attr,Str); {don't click if not visible}
  1386. end; {ScreenOBJ.WriteClick}
  1387.  
  1388. procedure ScreenOBJ.WriteCenter(Y,Attr:byte;Str:string);
  1389. {}
  1390. var 
  1391.   X1,Y1,X2,Y2: byte;
  1392.   X : integer; 
  1393. begin
  1394.    if oWritePtr^.WindowInEffect then
  1395.    begin
  1396.       oWritePtr^.GetWinCoords(X1,Y1,X2,Y2);
  1397.       X := (succ(X2-X1) - length(Str)) div 2;
  1398.    end
  1399.    else
  1400.       X :=  (Width - length(Str)) div 2;
  1401.    inc(X);                      {1.00e/f}
  1402.    if X < 1 then
  1403.       X := 1;
  1404.    WriteAt(X,Y,attr,Str);
  1405. end; {ScreenOBJ.WriteCenter}
  1406.  
  1407. procedure ScreenOBJ.WriteBetween(X1,X2,Y,Attr:byte;Str:string);
  1408. {}
  1409. var X : integer;
  1410. begin
  1411.    if length(Str) >= X2 - X1 + 1 then
  1412.       WriteAt(X1,Y,attr,Str)
  1413.    else
  1414.    begin
  1415.        X := X1 + (X2 - X1 + 1 - length(Str)) div 2 ;
  1416.        WriteAt(X,Y,attr,Str);
  1417.    end;
  1418. end; {ScreenOBJ.WriteBetween}
  1419.  
  1420. procedure ScreenOBJ.WriteRight(X,Y,Attr:byte;Str:string);
  1421. {writes a right-justified string to the screen}
  1422. var X1 : integer;
  1423. begin
  1424.    X1 := succ(X-length(Str));
  1425.    if X1 < 1 then
  1426.       X1 := 1;
  1427.    WriteAT(X1,Y,attr,Str);
  1428. end; {ScreenOBJ.WriteRight}
  1429.  
  1430. procedure ScreenOBJ.WriteVert(X,Y,Attr:byte;Str:string);
  1431. {}
  1432. var
  1433.    L: byte;
  1434.    I: integer;
  1435. begin
  1436.    L := length(Str);
  1437.    If L > succ(Monitor^.Depth) - Y then
  1438.       L := succ(Monitor^.Depth) - Y;
  1439.    for I := 1 to L do
  1440.       WriteAt(X,Y-1+I,attr,Str[I]);
  1441. end; {ScreenOBJ.WriteVert}
  1442.  
  1443. procedure ScreenOBJ.Attrib(X1,Y1,X2,Y2,Attr:byte);
  1444. {changes color attrib at specified coords}
  1445. var
  1446.    I: integer;
  1447.    X: byte;
  1448.    MVisible: boolean;
  1449. begin
  1450. {$IFNDEF FINAL}
  1451.    Exists;
  1452. {$ENDIF}
  1453.    MVisible := Mouse.Visible;
  1454.    if MVisible then
  1455.       Mouse.Hide;
  1456.    X := Succ(X2-X1);
  1457.    for I := Y1 to Y2 do
  1458.       oWritePtr^.ChangeAttr(X1,I,Attr,X);
  1459.    if MVisible then
  1460.       Mouse.Show;
  1461. end; {ScreenOBJ.Attrib}
  1462.  
  1463. procedure ScreenOBJ.Clear(Att:byte;Ch:char);
  1464. {}
  1465. begin
  1466.     PartClear(1,1,Width,Depth,Att,Ch);
  1467. end; {ScreenOBJ.Clear}
  1468.  
  1469. procedure ScreenOBJ.PartClear(X1,Y1,X2,Y2,Att:byte;Ch:char);
  1470. {}
  1471. var
  1472.    I : integer;
  1473.    S : string;
  1474. begin
  1475.    Attrib(X1,Y1,X2,Y2,Att);
  1476.    S := Replicate(Succ(X2-X1),Ch);
  1477.    for I := Y1 to Y2 do
  1478.       WritePlain(X1,I,S);
  1479. end; {ScreenOBJ.PartClear}
  1480.  
  1481. procedure ScreenOBJ.ClearText(X1,Y1,X2,Y2:byte);
  1482. {}
  1483. var
  1484.    I : integer;
  1485.    S : string;
  1486. begin
  1487.    S := Replicate(Succ(X2-X1),' ');
  1488.    for I := Y1 to Y2 do
  1489.        WritePlain(X1,I,S);
  1490. end; {ScreenOBJ.ClearText}
  1491.  
  1492. procedure ScreenOBJ.ReadWord(X,Y:byte;var Attr:byte; var Ch : char);
  1493. {updates vars Attr and Ch with attribute and character bytes in screen
  1494.  location (X,Y) of the active screen}
  1495. Type
  1496.   ScreenWordRec = record
  1497.      Ch   : char;   
  1498.      Attr : byte;
  1499.   end;
  1500. var
  1501.    VisiblePtr: pointer;
  1502.    VisibleAdr : word;
  1503.    SW : ScreenWordRec;
  1504. begin
  1505.     X := X + pred(oWritePtr^.WinX);
  1506.     Y := Y + pred(oWritePtr^.WinY);
  1507.     VisiblePtr := vScreenPtr;                {1.00b}
  1508.     VisibleAdr := pred(Y)*Monitor^.Width*2 + pred(X)*2;
  1509.     MoveFromScreen(mem[Seg(VisiblePtr^):ofs(VisiblePtr^)+VisibleAdr],
  1510.                       mem[seg(SW):ofs(SW)],1);
  1511.     Attr := SW.Attr;
  1512.     Ch   := SW.Ch;
  1513. end; {ScreenOBJ.ReadWord}
  1514.  
  1515. function ScreenOBJ.ReadChar(X,Y:byte):char;
  1516. var
  1517.    A : byte;
  1518.    C : char;
  1519. begin
  1520.     ReadWord(X,Y,A,C);
  1521.     ReadChar := C;
  1522. end; {ScreenOBJ.ReadChar}
  1523.  
  1524. function ScreenOBJ.ReadAttr(X,Y:byte):byte;
  1525. var
  1526.    A : byte;
  1527.    C : char;
  1528. begin
  1529.    ReadWord(X,Y,A,C);
  1530.    ReadAttr := A;
  1531. end; {ScreenOBJ.ReadAttr}
  1532.  
  1533. function ScreenOBJ.ReadStr(X1,X2,Y:byte):string;
  1534. var
  1535.    I : integer;
  1536.    Str: string;
  1537. begin
  1538.     Str := '';
  1539.     for I := X1 to X2 do
  1540.         Str := Str + ReadChar(I,Y);
  1541.     ReadStr := Str;
  1542. end; {ScreenOBJ.ReadStr}
  1543.  
  1544. procedure ScreenOBJ.TitleEngine(X1,Y1,X2,Y2,LeftPad,RightPad,Battr,Tattr:byte; 
  1545.                                 Str, Title: string);
  1546. {}
  1547. var
  1548.    TitVert: byte; {0-top, 1-dropbox, 2-bottom}
  1549.    TitHoriz:byte; {0-left, 1-center, 2-right}
  1550.    MaxWidth:integer;
  1551.    X,Y : byte;
  1552. begin
  1553.    if (Title[2] in [TitPos[1],TitPos[2],TitPos[3]])
  1554.    and (Title[1] in [TitPos[4],TitPos[5],TitPos[6]]) then {swap 'em}
  1555.    begin
  1556.       insert(Title[2],Title,1);
  1557.       delete(Title,3,1);
  1558.    end;
  1559.    if Title[1] = TitPos[1] then
  1560.       TitHoriz := 0
  1561.    else if Title[1] = TitPos[3] then
  1562.       TitHoriz := 2
  1563.    else
  1564.       TitHoriz := 1;
  1565.    if Title[1] in [TitPos[1],TitPos[2],TitPos[3]] then
  1566.       delete(Title,1,1);
  1567.    if Title = '' then exit;
  1568.    if (Title[1] = TitPos[5]) and (Y2-Y1 > 1) then
  1569.       TitVert := 1
  1570.    else if Title[1] = TitPos[6] then
  1571.       TitVert := 2
  1572.    else
  1573.       TitVert := 0;
  1574.    if Title[1] in [TitPos[4],TitPos[5],TitPos[6]] then
  1575.       delete(Title,1,1);
  1576.    if Title = '' then exit;
  1577.    {check title is narrow enough to fit}
  1578.    if TitVert = 1 then 
  1579.       MaxWidth :=  pred(X2-X1)
  1580.    else
  1581.       MaxWidth := X2-X1-3;
  1582.    if TitVert = 0 then
  1583.       dec(MaxWidth,LeftPad+RightPad);
  1584.    if MaxWidth <= 0 then
  1585.       Title := ''
  1586.    else
  1587.       delete(Title,succ(MaxWidth),255);  {truncate title}
  1588.    Case Titvert of
  1589.       0: begin
  1590.          Case TitHoriz of
  1591.             0 : WriteAt(succ(X1)+LeftPad,Y1,Tattr,Title);
  1592.             1 : WriteBetween(succ(X1)+LeftPad,pred(X2)-RightPad,y1,Tattr,Title);
  1593.             else WriteRight(pred(X2)-RightPad,Y1,Tattr,Title);
  1594.          end; {case}
  1595.       end;
  1596.       1: begin
  1597.          WriteAt(X1,Y1+2,Battr,str[8]+
  1598.                             replicate(pred(X2-X1),str[2])+
  1599.                             Str[5]);
  1600.          Case TitHoriz of
  1601.             0 : WriteAt(succ(X1),succ(Y1),Tattr,Title);
  1602.             1 : WriteBetween(X1,X2,succ(y1),Tattr,Title);
  1603.             else WriteRight(pred(X2),succ(Y1),Tattr,Title);
  1604.          end; {case}
  1605.       end;
  1606.       2: begin
  1607.          Case TitHoriz of
  1608.             0 : WriteAt(succ(X1),Y2,Tattr,Title);
  1609.             1 : WriteBetween(X1,X2,Y2,Tattr,Title);
  1610.             else WriteRight(pred(X2),Y2,Tattr,Title);
  1611.          end; {case}
  1612.       end;
  1613.    end; {case}
  1614. end; {ScreenOBJ.TitleEngine}
  1615.  
  1616. procedure ScreenOBJ.BoxEngine(X1,Y1,X2,Y2,LeftPad,RightPad,Battr,Tattr,MAttr,style:byte;
  1617.                               Filled: boolean;
  1618.                               Title: string);
  1619. {Used internally by Box and FBox}
  1620. const
  1621.    Style1:string[10] = '┌─┐│┤┘└├│─';
  1622.    Style2:string[10] = '╔═╗║╣╝╚╠║═';
  1623.    Style3:string[10] = '╓─╖║╢╜╙╟║─';
  1624.    Style4:string[10] = '╒═╕│╡╛╘╞│═';
  1625.    Style5:string[10] = '┌─╖│╡╝╘╞║═';
  1626. var
  1627.    Line,
  1628.    FLine,
  1629.    Str: string;
  1630.    I: integer;
  1631. begin
  1632.    if Style = 6 then
  1633.    begin
  1634.       PartClear(X1,Y1,X2,Y2,Mattr,' ');
  1635.       WriteAT(X1,Y1,BAttr,replicate(X2-pred(X1),char(223)));
  1636.       WriteAT(X1,Y1+2,BAttr,replicate(X2-pred(X1),'_'));
  1637.       WriteBetween(X1,X2,succ(Y1),Tattr,Title);
  1638.    end
  1639.    else
  1640.    begin
  1641.       case Style of
  1642.       0 : Str := '          ';
  1643.       1 : Str := Style1;
  1644.       2 : Str := Style2;
  1645.       3 : Str := Style3;
  1646.       4 : Str := Style4;
  1647.       5 : Str := Style5;
  1648.       else Str := Replicate(10,chr(style));
  1649.       end;
  1650.       WriteAt(X1,Y1,Battr,Str[1]);
  1651.       Line := replicate(pred(X2-X1),Str[2]);
  1652.       WriteAt(X1+1,Y1,Battr,Line);
  1653.       WriteAt(X2,Y1,Battr,Str[3]);
  1654.       for I := Y1+1 to Y2-1 do
  1655.       begin
  1656.          WriteAt(X1,I,Battr,Str[4]);
  1657.          WriteAt(X2,I,Battr,Str[9]);
  1658.       end;
  1659.       if Filled then
  1660.          PartClear(succ(X1),succ(Y1),pred(X2),pred(Y2),MAttr,' ');
  1661.       WriteAt(X1,Y2,Battr,Str[7]);
  1662.       Line := replicate(pred(X2-X1),Str[10]);
  1663.       WriteAt(X1+1,Y2,Battr,Line);
  1664.       WriteAt(X2,Y2,Battr,Str[6]);
  1665.       {now the title: extract the first two character positions, and draw it}
  1666.       if Title <> '' then
  1667.          TitleEngine(X1,Y1,X2,Y2,LeftPad,RightPad,Battr,Tattr,Str,Title);
  1668.    end;
  1669. end; {BoxEngine}
  1670.  
  1671. procedure ScreenOBJ.Box(X1,Y1,X2,Y2,attr,style:byte);
  1672. {draws box and leaves internal area as is}
  1673. begin
  1674.     BoxEngine(X1,Y1,X2,Y2,0,0,attr,attr,attr,Style,false,'');
  1675. end; {ScreenOBJ.Box}
  1676.  
  1677. procedure ScreenOBJ.FillBox(X1,Y1,X2,Y2,attr,style:byte);
  1678. {draws box and erases internal area}
  1679. begin
  1680.    BoxEngine(X1,Y1,X2,Y2,0,0,attr,attr,attr,Style,true,'');
  1681. end; {ScreenOBJ.FillBox}
  1682.  
  1683. procedure ScreenOBJ.ShadFillBox(X1,Y1,X2,Y2,attr,style:byte);
  1684. {draws box and erases internal area}
  1685. begin
  1686.    BoxEngine(X1,Y1,X2,Y2,0,0,attr,attr,attr,Style,true,'');
  1687.    ShadowTOT^.DrawShadowXY(X1,Y1,X2,Y2);
  1688. end; {ScreenOBJ.ShadFillBox}
  1689.  
  1690. procedure ScreenOBJ.TitledBox(X1,Y1,X2,Y2,Battr,Tattr,MAttr,style:byte;Title:string);
  1691. {}
  1692. begin
  1693.    BoxEngine(X1,Y1,X2,Y2,0,0,Battr,Tattr,MAttr,Style,true,title);
  1694. end; {ScreenOBJ.TitledFillBox}
  1695.  
  1696. procedure ScreenOBJ.HorizLine(X1,X2,Y,Attr,Style : byte);
  1697. var
  1698.   I : integer;
  1699.   LineChar : char;
  1700. begin
  1701.    case Style of
  1702.    0   : LineChar := ' ';
  1703.    2,4 : LineChar := '═';
  1704.    1,3 : LineChar := '─';
  1705.    else LineChar := Chr(Style);
  1706.    end; {case}
  1707.    WriteAt(X1,Y,Attr,replicate(X2-X1+1,LineChar))
  1708. end;   {ScreenOBJ.HorizLine}
  1709.  
  1710. procedure ScreenOBJ.VertLine(X,Y1,Y2,Attr,Style:byte);
  1711. {}
  1712. var
  1713.     I : integer;
  1714.     LineChar : char;
  1715. begin
  1716.    case Style of
  1717.    0   : LineChar := ' ';
  1718.    2,4 : LineChar := '║';
  1719.    1,3 : LineChar := '│';
  1720.    else LineChar := Chr(Style);
  1721.    end; {case}
  1722.    for I := Y1 to Y2 do
  1723.       WriteAt(X,I,Attr,LineChar)
  1724. end; {ScreenOBJ.VertLine}
  1725.  
  1726. procedure ScreenOBJ.SmartVertLine(X,Y1,Y2,Attr,Style:byte);
  1727. {draws box character and adjust any lines it overlays}
  1728. var
  1729.     I : integer;
  1730.     LineStr : string[19];
  1731.     TestCh,
  1732.     Ch : char;
  1733.     StringOffset : byte;
  1734.  
  1735.     function AdjacentChar(X,Y:byte): char;
  1736.     {}
  1737.     begin
  1738.        if (X < 1) or (X > width) then
  1739.           AdjacentChar := ' '
  1740.        else
  1741.           AdjacentChar := ReadChar(X,Y);
  1742.     end; {AdjacentChar}
  1743.  
  1744.     function LineCh(X,Y:byte): char;
  1745.     {}
  1746.     const
  1747.        LeftSingle: string[13] = '─┬┐┼┤┴┘╥╖╫╢╨╜';       
  1748.        LeftDouble: string[13] = '═╦╗╬╣╩╝╤╕╪╡╧╛';
  1749.        RightSingle:string[13] = '┌─┬├┼└┴╓╥╟╫╙╨';
  1750.        RightDouble:string[13] = '╔═╦╠╬╚╩╒╤╞╪╘╧';
  1751.     var
  1752.       LineStyle : char;
  1753.     begin
  1754.        LineStyle := AdjacentChar(pred(X),Y);
  1755.        if pos(LineStyle,RightSingle) > 0 then
  1756.           LineStyle := '─'
  1757.        else if pos(LineStyle,RightDouble) > 0 then
  1758.           LineStyle := '═'
  1759.        else
  1760.           LineStyle := ' ';
  1761.        case LineStyle of
  1762.        '─': if pos(AdjacentChar(succ(X),Y),leftSingle) > 0 then
  1763.                Ch := LineStr[2+StringOffset]
  1764.             else
  1765.                Ch := LineStr[3+StringOffset];
  1766.        '═': if pos(AdjacentChar(succ(X),Y),LeftDouble) > 0 then
  1767.                Ch := LineStr[4+StringOffset]
  1768.             else
  1769.                Ch := LineStr[5+StringOffset];
  1770.        else  TestCh := AdjacentChar(succ(X),Y);
  1771.              If pos(TestCh,LeftSingle) > 0 then
  1772.                 Ch := LineStr[6+StringOffset]
  1773.              else if pos(TestCh,LeftDouble) > 0  then
  1774.                 Ch := LineStr[7+StringOffset]
  1775.              else
  1776.                 Ch := LineStr[1];
  1777.        end; {case}
  1778.        LineCh := Ch;
  1779.     end; {LineCh}
  1780.  
  1781. begin
  1782.    if Style in [2,4] then
  1783.       LineStr := '║╥╖╦╗╓╔╫╢╬╣╟╠╨╜╩╝╙╚'
  1784.    else
  1785.       LineStr := '│┬┐╤╕┌╒┼┤╪╡├╞┴┘╧╛└╘';
  1786.    {draw first character}
  1787.    StringOffSet := 0;
  1788.    WriteAt(X,Y1,attr,LineCh(X,Y1));
  1789.    StringOffSet := 6;
  1790.    for I := succ(Y1) to pred(Y2) do
  1791.       WriteAt(X,I,attr,LineCh(X,I));
  1792.    StringOffSet := 12;
  1793.    WriteAt(X,Y2,attr,LineCh(X,Y2));
  1794. end; {ScreenOBJ.SmartVertLine}
  1795.  
  1796. procedure ScreenOBJ.SmartHorizLine(X1,X2,Y,Attr,Style:byte);
  1797. {draws box character and adjust any lines it overlays}
  1798. var
  1799.     I : integer;
  1800.     LineStr : string[19];
  1801.     TestCh,
  1802.     Ch : char;
  1803.     StringOffset : byte;
  1804.  
  1805.     function AdjacentChar(X,Y:byte): char;
  1806.     {}
  1807.     begin
  1808.        if (Y < 1) or (Y > depth) then
  1809.           AdjacentChar := ' '
  1810.        else
  1811.           AdjacentChar := ReadChar(X,Y);
  1812.     end; {AdjacentChar}
  1813.  
  1814.     function LineCh(X,Y:byte): char;
  1815.     {}
  1816.     const
  1817.         DownSingle: string[13] = '┌┬┐│├┼┤╒╤╕╞╪╡';
  1818.  
  1819.         DownDouble: string[13] = '╔╦╗║╠╬╣╓╥╖╟╫╢';
  1820.  
  1821.         UpSingle:   string[13] = '│├┼┤└┴┘╞╪╡╘╧╛';
  1822.  
  1823.         UpDouble:   string[13] = '║╠╬╣╚╩╝╟╫╢╙╨║';
  1824.     var
  1825.       LineStyle : char;
  1826.     begin
  1827.        LineStyle := AdjacentChar(X,pred(Y));
  1828.        If pos(LineStyle,DownSingle) > 0 then
  1829.           LineStyle := '│'
  1830.        else if pos(LineStyle,DownDouble) > 0 then
  1831.           LineStyle := '║'
  1832.        else                    
  1833.           LineStyle := ' ';
  1834.        case LineStyle of
  1835.        '│': if pos(AdjacentChar(X,succ(Y)),UpSingle) > 0 then
  1836.                Ch := LineStr[2+StringOffset]
  1837.             else
  1838.                Ch := LineStr[3+StringOffset];
  1839.        '║': if pos(AdjacentChar(X,succ(Y)),UpDouble) > 0 then
  1840.                Ch := LineStr[4+StringOffset]
  1841.             else
  1842.                Ch := LineStr[5+StringOffset];
  1843.        else  TestCh := AdjacentChar(X,succ(Y));
  1844.              If pos(TestCh,UpSingle) > 0 then
  1845.                 Ch := LineStr[6+StringOffset]
  1846.              else if pos(TestCh,UpDouble) > 0 then
  1847.                 Ch := LineStr[7+StringOffset]
  1848.              else
  1849.                 Ch := LineStr[1];
  1850.        end; {case}
  1851.        LineCh := Ch;
  1852.     end; {LineCh}
  1853.  
  1854. begin
  1855.    if Style in [2,4] then
  1856.       LineStr := '═╞╘╠╚╒╔╪╧╬╩╤╦╡╛╣╝╕╗ '
  1857.    else
  1858.       LineStr := '─├└╟╙┌╓┼┴╫╨┬╥┤┘╢╜┐╖';
  1859.    {draw first character}
  1860.    StringOffSet := 0;
  1861.    WriteAt(X1,Y,attr,LineCh(X1,Y));
  1862.    StringOffSet := 6;
  1863.    for I := succ(X1) to pred(X2) do
  1864.       WriteAt(I,Y,attr,LineCh(I,Y));
  1865.    StringOffSet := 12;
  1866.    WriteAt(X2,Y,attr,LineCh(X2,Y));
  1867. end; {ScreenOBJ.SmartHorizLine}
  1868.  
  1869. procedure ScreenOBJ.WriteHScrollBar(X1,X2,Y,Attr: byte; Current,Max: longint);
  1870. {}
  1871. var 
  1872.   X,LineLength : integer;
  1873. begin
  1874.    WriteAT(X1,Y,Attr,ScrollTOT^.LeftChar);
  1875.    WriteAT(X2,Y,Attr,ScrollTOT^.RightChar);
  1876.    WriteAT(succ(X1),Y,Attr,replicate(pred(X2-X1),ScrollTOT^.BackgroundChar));
  1877.    if (Current > 0) and (Max >= Current) then
  1878.    begin
  1879.      LineLength := X2 - succ(X1);
  1880.      if LineLength > 0 then
  1881.      begin
  1882.         X := (Current * LineLength) div Max;
  1883.         if Current >= Max then
  1884.            X := pred(LineLength);
  1885.         if (X < 0) or (Current = 1) then
  1886.            X := 0;
  1887.         WriteAT(succ(X1) + X,Y,Attr,ScrollTOT^.ElevatorChar);
  1888.      end;
  1889.    end;
  1890. end; {ScreenOBJ.WriteHScrollBar}
  1891.  
  1892. procedure ScreenOBJ.WriteVScrollBar(X,Y1,Y2,Attr: byte; Current,Max: longint);
  1893. {}
  1894. var 
  1895.   BC : char;
  1896.   I,Y,LineLength : integer;
  1897. begin
  1898.    WriteAT(X,Y1,Attr,ScrollTOT^.UpChar);
  1899.    WriteAT(X,Y2,Attr,ScrollTOT^.DownChar);
  1900.    BC := ScrollTOT^.BackgroundChar;
  1901.    for I := succ(Y1) to pred(Y2) do
  1902.        WriteAT(X,I,Attr,BC);
  1903.    if (Current > 0) and (Max >= Current) then
  1904.    begin
  1905.      LineLength := Y2 - succ(Y1);
  1906.      if LineLength > 0 then
  1907.      begin
  1908.         Y := (Current * LineLength) div Max;
  1909.         if Current >= Max then
  1910.            Y := pred(LineLength);
  1911.         if (Y < 0) or (Current = 1) then
  1912.            Y := 0;
  1913.         WriteAT(X,succ(Y1)+Y,Attr,ScrollTOT^.ElevatorChar);
  1914.      end;
  1915.    end;
  1916. end; {ScreenOBJ.WriteVScrollBar}
  1917.  
  1918. destructor ScreenOBJ.Done;
  1919. {}
  1920. var MemoryUsed: longint;
  1921. begin
  1922.    If not OnScreen then
  1923.    begin
  1924.       MemoryUsed := Width*Depth*2;
  1925.       freemem(vScreenPtr,MemoryUsed);
  1926.       dispose(oWritePtr,Done);
  1927.    end;
  1928. end;  {ScreenOBJ.Done}
  1929. {|||||||||||||||||||||||||||||||||||||||||||}
  1930. {                                           }
  1931. {     S c r o l l O B J   M E T H O D S     }
  1932. {                                           }
  1933. {|||||||||||||||||||||||||||||||||||||||||||}
  1934. constructor ScrollOBJ.Init;
  1935. {}
  1936. begin
  1937.    SetDefaults;
  1938. end; {ScrollOBJ.Init}
  1939.  
  1940. procedure ScrollOBJ.SetDefaults;
  1941. {}
  1942. begin
  1943.    SetScrollChars('','',char(27),char(26),'','░');
  1944. end;  {of ScrollOBJ.SetDefaults}
  1945.  
  1946. procedure ScrollOBJ.SetScrollChars(U,D,L,R,E,B:char);
  1947. {}
  1948.  
  1949. begin
  1950.    vUpArrowChar := U;
  1951.    vDownArrowChar := D; 
  1952.    vLeftArrowChar := L; 
  1953.    vRightArrowChar := R;
  1954.    vElevatorChar := E;
  1955.    vBackgroundChar := B;
  1956. end;  {of ScrollOBJ.SetScrollChars}
  1957.  
  1958. function ScrollOBJ.UpChar:char;
  1959. {}
  1960. begin
  1961.    UpChar := vUpArrowChar;
  1962. end; {ScrollOBJ.UpChar}
  1963.  
  1964. function ScrollOBJ.DownChar:char;
  1965. {}
  1966. begin
  1967.    DownChar := vDownArrowChar;
  1968. end; {ScrollOBJ.DownChar}
  1969.  
  1970. function ScrollOBJ.LeftChar:char;
  1971. {}
  1972. begin
  1973.    LeftChar := vLeftArrowChar;
  1974. end; {ScrollOBJ.LeftChar}
  1975.  
  1976. function ScrollOBJ.RightChar:char;
  1977. {}
  1978. begin
  1979.    RightChar := vRightArrowChar;
  1980. end; {ScrollOBJ.RightChar}
  1981.  
  1982. function ScrollOBJ.ElevatorChar:char;
  1983. {}
  1984. begin
  1985.    ElevatorChar := vElevatorChar;
  1986. end; {ScrollOBJ.ElevatorChar}
  1987.  
  1988. function ScrollOBJ.BackgroundChar:char;
  1989. {}
  1990. begin
  1991.    BackgroundChar := vBackgroundChar;
  1992. end; {ScrollOBJ.BackgroundChar}
  1993.  
  1994. destructor ScrollOBJ.Done;
  1995. begin end;
  1996. {|||||||||||||||||||||||||||||||||||||||||||}
  1997. {                                           }
  1998. {     S h a d o w O B J   M E T H O D S     }
  1999. {                                           }
  2000. {|||||||||||||||||||||||||||||||||||||||||||}
  2001. constructor ShadowOBJ.Init;
  2002. {}
  2003. begin
  2004.    SetDefaults;
  2005. end; {ShadowOBJ.Init}
  2006.  
  2007. procedure ShadowOBJ.SetDefaults;
  2008. {}
  2009. begin
  2010.    vShadWidth := 2;
  2011.    vShadDepth := 1;
  2012.    vShadPos := DownRight;
  2013.    vShadAttr := 7;
  2014.    vShadChar := ' ';
  2015. end; {ShadowOBJ.SetDefaults}
  2016.  
  2017. procedure ShadowOBJ.DrawShadow(Border:tCoords);
  2018. {}
  2019. var
  2020.   Outer: tCoords;
  2021.  
  2022.   procedure DrawPartofShadow(X1,Y1,X2,Y2:byte);
  2023.   begin
  2024.      if (X1 > X2) or (Y1 > Y2) then exit;
  2025.      if vShadChar = ' ' then {attribute change}
  2026.         Screen.Attrib(X1,Y1,X2,Y2,vShadAttr)
  2027.      else
  2028.         Screen.PartClear(X1,Y1,X2,Y2,vShadAttr,vShadChar);
  2029.   end; {of sub proc DrawPartofShadow}
  2030.  
  2031. begin
  2032.    OuterCoords(Border,Outer);
  2033.    case vShadPos of
  2034.    UpLeft:   begin
  2035.                 DrawPartofShadow(Outer.X1,Outer.Y1,pred(Border.X1),Border.Y2-vShadDepth);
  2036.                 DrawPartofShadow(Border.X1,Outer.Y1,Border.X2-vShadWidth,pred(Border.Y1));
  2037.              end;
  2038.    UpRight:  begin
  2039.                 DrawPartofShadow(Border.X1+vShadWidth,Outer.Y1,Outer.X2,pred(Border.Y1));
  2040.                 DrawPartofShadow(succ(Border.X2),Border.Y1,Outer.X2,Border.Y2-vShadDepth);
  2041.              end;
  2042.    DownLeft: begin
  2043.                 DrawPartofShadow(Outer.X1,Border.Y1+vShadDepth,pred(Border.X1),Outer.Y2);
  2044.                 DrawPartofShadow(Border.X1,succ(Border.Y2),Border.X2-vShadWidth,Outer.Y2);
  2045.              end;
  2046.    DownRight:begin
  2047.                 DrawPartofShadow(Border.X1+vShadWidth,succ(Border.Y2),Outer.X2,Outer.Y2);
  2048.                 DrawPartofShadow(succ(Border.X2),Border.Y1+vShadDepth,Outer.X2,Border.Y2);
  2049.              end;
  2050.    end; {case}
  2051. end; {ShadowOBJ.DrawShadow}
  2052.  
  2053. procedure ShadowOBJ.DrawShadowXY(X1,Y1,X2,Y2:integer);
  2054. {}
  2055. var
  2056.   Border: tCoords;
  2057. begin
  2058.    Border.X1 := X1;
  2059.    Border.Y1 := Y1;
  2060.    Border.X2 := X2;
  2061.    Border.Y2 := Y2;
  2062.    DrawShadow(Border);
  2063. end; {ShadowOBJ.DrawShadowXY}
  2064.  
  2065. procedure ShadowOBJ.SetShadowStyle(ShadP:ShadowPosition; ShadA:byte; ShadC:char);
  2066. {}
  2067. begin
  2068.    vShadPos  :=  ShadP;
  2069.    vShadAttr :=  ShadA;
  2070.    vShadChar :=  ShadC;
  2071. end; {ShadowOBJ.SetShadowStyle}
  2072.  
  2073. procedure ShadowOBJ.SetShadowSize(ShadW,ShadD:byte);
  2074. {}
  2075. begin
  2076.    vShadWidth := ShadW;
  2077.    vShadDepth := ShadD;
  2078. end; {ShadowOBJ.SetShadowSize}
  2079.  
  2080. function ShadowOBJ.ShadWidth: byte;
  2081. {}
  2082. begin
  2083.    ShadWidth := vShadWidth;
  2084. end; {ShadowOBJ.ShadWidth}
  2085.  
  2086. function ShadowOBJ.ShadDepth: byte;
  2087. {}
  2088. begin
  2089.    ShadDepth := vShadDepth;
  2090. end; {ShadowOBJ.ShadDepth}
  2091.  
  2092. function ShadowOBJ.ShadAttr: byte;
  2093. {}
  2094. begin
  2095.    ShadAttr := vShadAttr;
  2096. end; {ShadowOBJ.ShadAttr}
  2097.  
  2098. function ShadowOBJ.ShadChar: char;
  2099. {}
  2100. begin
  2101.    ShadChar := vShadChar;
  2102. end; {ShadowOBJ.ShadChar}
  2103.  
  2104. function ShadowOBJ.ShadPos: ShadowPosition;
  2105. {}
  2106. begin
  2107.    ShadPos := vShadPos;
  2108. end; {ShadowOBJ.ShadPos}
  2109.  
  2110. procedure ShadowOBJ.OuterCoords(Border:tCoords;var Outer:tCoords);
  2111. {}
  2112. begin
  2113.    Case vShadPos of
  2114.    UpLeft:   begin
  2115.                 Outer.X1 := Border.X1-vShadWidth;
  2116.                 Outer.Y1 := Border.Y1-vShadDepth;
  2117.                 Outer.X2 := Border.X2;
  2118.                 Outer.Y2 := Border.Y2;
  2119.              end;
  2120.    UpRight:  begin
  2121.                 Outer.X1 := Border.X1;
  2122.                 Outer.Y1 := Border.Y1-vShadDepth;
  2123.                 Outer.X2 := Border.X2+vShadWidth;
  2124.                 Outer.Y2 := Border.Y2;
  2125.              end;
  2126.    DownLeft: begin
  2127.                 Outer.X1 := Border.X1-vShadWidth;
  2128.                 Outer.Y1 := Border.Y1;
  2129.                 Outer.X2 := Border.X2;
  2130.                 Outer.Y2 := Border.Y2+vShadDepth;
  2131.              end;
  2132.    DownRight:begin
  2133.                 Outer.X1 := Border.X1;
  2134.                 Outer.Y1 := Border.Y1;
  2135.                 Outer.X2 := Border.X2+vShadWidth;
  2136.                 Outer.Y2 := Border.Y2+vShadDepth;
  2137.              end;
  2138.    end; {case}
  2139.    if Outer.X1 < 1 then Outer.X1 := 1;
  2140.    if Outer.Y1 < 1 then Outer.Y1 := 1;
  2141.    if Outer.X2 > Screen.Width then Outer.X2 := Screen.Width;
  2142.    if Outer.Y2 > Screen.Depth then Outer.Y2 := Screen.Depth;
  2143. end; {ShadowOBJ.OuterCoords}
  2144.  
  2145. procedure ShadowOBJ.OuterXY(var X1,Y1,X2,Y2: integer);
  2146. {}
  2147. var Temp1,Temp2:tCoords;
  2148. begin
  2149.    Temp1.X1 := X1;
  2150.    Temp1.Y1 := Y1;
  2151.    Temp1.X2 := X2;
  2152.    Temp1.Y2 := Y2;
  2153.    OuterCoords(Temp1,Temp2);
  2154.    X1 := Temp2.X1;
  2155.    Y1 := Temp2.Y1;
  2156.    X2 := Temp2.X2;
  2157.    Y2 := Temp2.Y2;
  2158. end; {ShadowOBJ.OuterXY}
  2159.  
  2160. destructor ShadowOBJ.Done;
  2161. begin end;
  2162.  
  2163. {|||||||||||||||||||||||||||||||||||||||||||||||}
  2164. {                                               }
  2165. {     U N I T   I N I T I A L I Z A T I O N     }
  2166. {                                               }
  2167. {|||||||||||||||||||||||||||||||||||||||||||||||}
  2168.  
  2169. procedure FastInit;
  2170. {initilizes objects and global variables}
  2171. begin
  2172.     Screen.Init;
  2173.     Screen.Create(0,0,0);
  2174.     new(ScrollTOT,Init);
  2175.     new(ShadowTOT,Init);
  2176. end; {FastInit}
  2177.  
  2178. {end of unit - add intialization routines below}
  2179. {$IFNDEF OVERLAY}
  2180. begin
  2181.    FastInit;
  2182. {$ENDIF}
  2183. end.
  2184.  
  2185.